home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / role / roleplay.0-s / roleplay / RolePlaying-1.0 / Install.tcl < prev    next >
Text File  |  1995-07-31  |  35KB  |  1,172 lines
  1. #!/usr/bin/X11/wish -f
  2. # Program: Install
  3. # Tcl version: 7.3 (Tcl/Tk/XF)
  4. # Tk version: 3.6
  5. # XF version: $__lastrelease$
  6. #
  7.  
  8. # module inclusion
  9. global env
  10. global xfLoadPath
  11. if {[info exists env(XF_LOAD_PATH)]} {
  12.   if {[string first $env(XF_LOAD_PATH) /usr/local/lib/] == -1} {
  13.     set xfLoadPath $env(XF_LOAD_PATH):/usr/local/lib/
  14.   } {
  15.     set xfLoadPath /usr/local/lib/
  16.   }
  17. } {
  18.   set xfLoadPath /usr/local/lib/
  19. }
  20.  
  21. global argc
  22. global argv
  23. global tkVersion
  24. global xfLoadInfo
  25. global xfLoadPath
  26. set xfLoadInfo 0
  27. set tmpArgv ""
  28. for {set counter 0} {$counter < $argc} {incr counter 1} {
  29.   case [string tolower [lindex $argv $counter]] in {
  30.     {-xfloadpath} {
  31.       incr counter 1
  32.       set xfLoadPath "[lindex $argv $counter]:$xfLoadPath"
  33.     }
  34.     {-xfstartup} {
  35.       incr counter 1
  36.       source [lindex $argv $counter]
  37.     }
  38.     {-xfbindfile} {
  39.       incr counter 1
  40.       set env(XF_BIND_FILE) "[lindex $argv $counter]"
  41.     }
  42.     {-xfcolorfile} {
  43.       incr counter 1
  44.       set env(XF_COLOR_FILE) "[lindex $argv $counter]"
  45.     }
  46.     {-xfcursorfile} {
  47.       incr counter 1
  48.       set env(XF_CURSOR_FILE) "[lindex $argv $counter]"
  49.     }
  50.     {-xffontfile} {
  51.       incr counter 1
  52.       set env(XF_FONT_FILE) "[lindex $argv $counter]"
  53.     }
  54.     {-xfmodelmono} {
  55.       if {$tkVersion >= 3.0} {
  56.         tk colormodel . monochrome
  57.       }
  58.     }
  59.     {-xfmodelcolor} {
  60.       if {$tkVersion >= 3.0} {
  61.         tk colormodel . color
  62.       }
  63.     }
  64.     {-xfloading} {
  65.       set xfLoadInfo 1
  66.     }
  67.     {-xfnoloading} {
  68.       set xfLoadInfo 0
  69.     }
  70.     {default} {
  71.       lappend tmpArgv [lindex $argv $counter]
  72.     }
  73.   }
  74. }
  75. set argv $tmpArgv
  76. set argc [llength $tmpArgv]
  77. unset counter
  78. unset tmpArgv
  79.  
  80.  
  81. # procedure to show window .
  82. proc ShowWindow. {args} {# xf ignore me 7
  83.  
  84.   # Window manager configurations
  85.   global tkVersion
  86.   wm positionfrom . user
  87.   wm sizefrom . ""
  88.   wm maxsize . 1024 768
  89.   wm title . {Install.tcl}
  90.  
  91.  
  92.   # build widget .frame1
  93.   frame .frame1 \
  94.     -borderwidth {2}
  95.  
  96.   # build widget .frame1.entry7
  97.   entry .frame1.entry7 \
  98.     -relief {sunken}
  99.   # bindings
  100.   bind .frame1.entry7 <Key-Return> {focus [SN ExecutablePath]}
  101.   bind .frame1.entry7 <Key-Tab> {focus [SN ExecutablePath]}
  102.  
  103.   # build widget .frame1.label6
  104.   label .frame1.label6 \
  105.     -text {Script Path:}
  106.  
  107.   # pack widget .frame1
  108.   pack append .frame1 \
  109.     .frame1.label6 {left frame center} \
  110.     .frame1.entry7 {top frame center expand fillx} 
  111.  
  112.   # build widget .frame2
  113.   frame .frame2 \
  114.     -borderwidth {2}
  115.  
  116.   # build widget .frame2.entry19
  117.   entry .frame2.entry19 \
  118.     -relief {sunken}
  119.   # bindings
  120.   bind .frame2.entry19 <Key-Return> {focus [SN BinPath]}
  121.   bind .frame2.entry19 <Key-Tab> {focus [SN BinPath]}
  122.  
  123.   # build widget .frame2.label8
  124.   label .frame2.label8 \
  125.     -text {Executable Path:}
  126.  
  127.   # pack widget .frame2
  128.   pack append .frame2 \
  129.     .frame2.label8 {left frame center} \
  130.     .frame2.entry19 {left frame center expand fillx} 
  131.  
  132.   # build widget .frame3
  133.   frame .frame3 \
  134.     -borderwidth {2}
  135.  
  136.   # build widget .frame3.entry13
  137.   entry .frame3.entry13 \
  138.     -relief {sunken}
  139.   # bindings
  140.   bind .frame3.entry13 <Key-Return> {focus [SN InfoPath]}
  141.   bind .frame3.entry13 <Key-Tab> {focus [SN InfoPath]}
  142.  
  143.   # build widget .frame3.label12
  144.   label .frame3.label12 \
  145.     -text {Bin Path:}
  146.  
  147.   # pack widget .frame3
  148.   pack append .frame3 \
  149.     .frame3.label12 {left frame center} \
  150.     .frame3.entry13 {left frame center expand fillx} 
  151.  
  152.   # build widget .frame4
  153.   frame .frame4 \
  154.     -borderwidth {2}
  155.  
  156.   # build widget .frame4.entry15
  157.   entry .frame4.entry15 \
  158.     -relief {sunken}
  159.   # bindings
  160.   bind .frame4.entry15 <Key-Return> {[SN InstallButton] invoke}
  161.  
  162.   # build widget .frame4.label14
  163.   label .frame4.label14 \
  164.     -text {Info Path:}
  165.  
  166.   # pack widget .frame4
  167.   pack append .frame4 \
  168.     .frame4.label14 {left frame center} \
  169.     .frame4.entry15 {left frame center expand fillx} 
  170.  
  171.   # build widget .frame5
  172.   frame .frame5 \
  173.     -borderwidth {2}
  174.  
  175.   # build widget .frame5.button16
  176.   button .frame5.button16 \
  177.     -command {DoInstall}\
  178.     -text {Install It!}
  179.  
  180.   # build widget .frame5.button17
  181.   button .frame5.button17 \
  182.     -command {exit}\
  183.     -text {Don't Install}
  184.  
  185.   # build widget .frame5.button18
  186.   button .frame5.button18 \
  187.     -command {GiveHelp}\
  188.     -text {Help}
  189.  
  190.   # pack widget .frame5
  191.   pack append .frame5 \
  192.     .frame5.button16 {left frame center expand} \
  193.     .frame5.button17 {left frame center expand} \
  194.     .frame5.button18 {left frame center expand} 
  195.  
  196.   # build widget .label0
  197.   label .label0 \
  198.     -font {-Adobe-Helvetica-Bold-R-Normal--*-240-*}\
  199.     -text {Role Playing DataBase System Installation}
  200.  
  201.   # pack widget .
  202.   pack append . \
  203.     .label0 {top frame center fillx} \
  204.     .frame1 {top frame center fillx} \
  205.     .frame2 {top frame center fillx} \
  206.     .frame3 {top frame center fillx} \
  207.     .frame4 {top frame center fillx} \
  208.     .frame5 {top frame center fillx} 
  209.  
  210.   if {"[info procs XFEdit]" != ""} {
  211.     XFEditSetShowWindows
  212.     XFMiscBindWidgetTree .xfInfoWidgetTree
  213.   }
  214.  
  215.   .frame1.entry7 insert end {/usr/local/lib/RPG/scripts}
  216.   .frame2.entry19 insert end {/usr/local/lib/RPG/RPGwish}
  217.   .frame3.entry13 insert end {/usr/local/bin/RolePlayingDB}
  218.   .frame4.entry15 insert end {/usr/local/lib/RPG/Info}
  219.  
  220.  
  221. }
  222.  
  223.  
  224. # User defined procedures
  225.  
  226.  
  227. # Procedure: DoInstall
  228. proc DoInstall {} {
  229.   set scriptPath [[SN ScriptPath] get]
  230.   set executablePath [[SN ExecutablePath] get]
  231.   set binPath [[SN BinPath] get]
  232.   set infoPath [[SN InfoPath] get]
  233.   if {![IsADir $scriptPath]} {
  234.     if {[catch "exec mkdir -p $scriptPath" error]} {
  235.        tkerror "Could not create script directory: $scriptPath\n$error"
  236.        return
  237.     }
  238.   }
  239.   if {[catch "exec cp [glob scripts/*] $scriptPath" error]} {
  240.      tkerror "Could not copy scripts to $scriptPath\n$error"
  241.      return  
  242.   }
  243.   set exeDir [file dirname $executablePath]
  244.   if {![IsADir $exeDir]} {
  245.     if {[catch "exec mkdir -p $exeDir" error]} {
  246.       tkerror "Could not create exe directory: $exeDir\n$error"
  247.       return
  248.     }
  249.   }
  250.   if {[catch "exec cp bin/RPGwish $executablePath" error]} {
  251.     tkerror "Cound not copy executable to $executablePath\n$error"
  252.     return
  253.   }
  254.   set binDir [file dirname $binPath]
  255.   if {![IsADir $binDir]} {
  256.     if {[catch "exec mkdir -p $binDir" error]} {
  257.        tkerror "Could not create bin directory: $binDir\n$error"
  258.        return
  259.     }
  260.   }
  261.   set binFile {}
  262.   if {[catch "open $binPath w" binFile]} {
  263.     tkerror "Could not open $binPath: $binFile"
  264.     return
  265.   }
  266.   puts $binFile "#!/bin/sh"
  267.   puts $binFile "$executablePath -f $scriptPath/RolePlayingDB"
  268.   close $binFile
  269.   catch "exec chmod +x $binPath"
  270.   if {![IsADir $infoPath]} {
  271.     if {[catch "exec mkdir -p $infoPath" error]} {
  272.        tkerror "Could not create Info directory: $infoPath\n$error"
  273.        return
  274.     }
  275.   }
  276.   if {[catch "exec cp [glob Info/*] $infoPath" error]} {
  277.     tkerror "Could not copy Info files to $infoPath\n$error"
  278.     return
  279.   }
  280.   catch "exec ln -s $infoPath $scriptPath/Info"
  281.   exit
  282. }
  283.  
  284.  
  285. # Procedure: GiveHelp
  286. proc GiveHelp {} {
  287.   TextBox {Role Playing DataBase System Installation Help
  288.  
  289. The Role Playing DataBase System needs four paths:
  290.  
  291.   1) The name of te directory the scripts are to be installed
  292.      in.
  293.   2) The installed filename for the customized RPG wish.
  294.   3) The name of the /bin/sh script to start up the 
  295.      Role Playing DataBase System.
  296.   4) The directory where the Info file (on-line help).
  297.  
  298. Enter the four paths and then select the Install It! button.
  299. If the installation was successfull, the Install program will
  300. go away.  Otherwise an error message will popup.
  301. } {} {500x225}
  302. }
  303.  
  304.  
  305. # Procedure: IsADir
  306. proc IsADir { pathName} {
  307. # xf ignore me 5
  308. ##########
  309. # Procedure: IsADir
  310. # Description: check if name is a directory (including symbolic links)
  311. # Arguments: pathName - the path to check
  312. # Returns: 1 if its a directory, otherwise 0
  313. # Sideeffects: none
  314. ##########
  315.  
  316.   if {[file isdirectory $pathName]} {
  317.     return 1
  318.   } {
  319.     catch "file type $pathName" fileType
  320.     if {"$fileType" == "link"} {
  321.       if {[catch "file readlink $pathName" linkName]} {
  322.         return 0
  323.       }
  324.       catch "file type $linkName" fileType
  325.       while {"$fileType" == "link"} {
  326.         if {[catch "file readlink $linkName" linkName]} {
  327.           return 0
  328.         }
  329.         catch "file type $linkName" fileType
  330.       }
  331.       return [file isdirectory $linkName]
  332.     }
  333.   }
  334.   return 0
  335. }
  336.  
  337.  
  338. # Procedure: IsAFile
  339. proc IsAFile { fileName} {
  340. # xf ignore me 5
  341. ##########
  342. # Procedure: IsAFile
  343. # Description: check if filename is a file (including symbolic links)
  344. # Arguments: fileName - the filename to check
  345. # Returns: 1 if its a file, otherwise 0
  346. # Sideeffects: none
  347. ##########
  348.  
  349.   if {[file isfile $fileName]} {
  350.     return 1
  351.   } {
  352.     catch "file type $fileName" fileType
  353.     if {"$fileType" == "link"} {
  354.       if {[catch "file readlink $fileName" linkName]} {
  355.         return 0
  356.       }
  357.       catch "file type $linkName" fileType
  358.       while {"$fileType" == "link"} {
  359.         if {[catch "file readlink $linkName" linkName]} {
  360.           return 0
  361.         }
  362.         catch "file type $linkName" fileType
  363.       }
  364.       return [file isfile $linkName]
  365.     }
  366.   }
  367.   return 0
  368. }
  369.  
  370.  
  371. # Procedure: TextBox
  372. proc TextBox { {textBoxMessage "Text message"} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
  373. # xf ignore me 5
  374. ##########
  375. # Procedure: TextBox
  376. # Description: show text box
  377. # Arguments: {textBoxMessage} - the text to display
  378. #            {textBoxCommand} - the command to call after ok
  379. #            {textBoxGeometry} - the geometry for the window
  380. #            {textBoxTitle} - the title for the window
  381. #            {args} - labels of buttons
  382. # Returns: The number of the selected button, or nothing
  383. # Sideeffects: none
  384. # Notes: there exist also functions called:
  385. #          TextBoxFile - to open and read a file automatically
  386. #          TextBoxFd - to read from an already opened filedescriptor
  387. ##########
  388. #
  389. # global textBox(activeBackground) - active background color
  390. # global textBox(activeForeground) - active foreground color
  391. # global textBox(background) - background color
  392. # global textBox(font) - text font
  393. # global textBox(foreground) - foreground color
  394. # global textBox(scrollActiveForeground) - scrollbar active background color
  395. # global textBox(scrollBackground) - scrollbar background color
  396. # global textBox(scrollForeground) - scrollbar foreground color
  397. # global textBox(scrollSide) - side where scrollbar is located
  398.  
  399.   global textBox
  400.  
  401.   # show text box
  402.   if {[llength $args] > 0} {
  403.     eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  404.   } {
  405.     TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  406.   }
  407.  
  408.   if {[llength $args] > 0} {
  409.     # wait for the box to be destroyed
  410.     update idletask
  411.     grab $textBox(toplevelName)
  412.     tkwait window $textBox(toplevelName)
  413.  
  414.     return $textBox(button)
  415.   }
  416. }
  417.  
  418.  
  419. # Procedure: TextBoxFd
  420. proc TextBoxFd { {textBoxInFile ""} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
  421. # xf ignore me 5
  422. ##########
  423. # Procedure: TextBoxFd
  424. # Description: show text box containing a filedescriptor
  425. # Arguments: {textBoxInFile} - a filedescriptor to read. The descriptor
  426. #                              is closed after reading
  427. #            {textBoxCommand} - the command to call after ok
  428. #            {textBoxGeometry} - the geometry for the window
  429. #            {textBoxTitle} - the title for the window
  430. #            {args} - labels of buttons
  431. # Returns: The number of the selected button, ot nothing
  432. # Sideeffects: none
  433. # Notes: there exist also functions called:
  434. #          TextBox - to display a passed string
  435. #          TextBoxFile - to open and read a file automatically
  436. ##########
  437. #
  438. # global textBox(activeBackground) - active background color
  439. # global textBox(activeForeground) - active foreground color
  440. # global textBox(background) - background color
  441. # global textBox(font) - text font
  442. # global textBox(foreground) - foreground color
  443. # global textBox(scrollActiveForeground) - scrollbar active background color
  444. # global textBox(scrollBackground) - scrollbar background color
  445. # global textBox(scrollForeground) - scrollbar foreground color
  446. # global textBox(scrollSide) - side where scrollbar is located
  447.  
  448.   global textBox
  449.  
  450.   # check file existance
  451.   if {"$textBoxInFile" == ""} {
  452.     puts stderr "No filedescriptor specified"
  453.     return
  454.   }
  455.  
  456.   set textBoxMessage [read $textBoxInFile]
  457.   close $textBoxInFile
  458.  
  459.   # show text box
  460.   if {[llength $args] > 0} {
  461.     eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  462.   } {
  463.     TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  464.   }
  465.  
  466.   if {[llength $args] > 0} {
  467.     # wait for the box to be destroyed
  468.     update idletask
  469.     grab $textBox(toplevelName)
  470.     tkwait window $textBox(toplevelName)
  471.  
  472.     return $textBox(button)
  473.   }
  474. }
  475.  
  476.  
  477. # Procedure: TextBoxFile
  478. proc TextBoxFile { {textBoxFile ""} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
  479. # xf ignore me 5
  480. ##########
  481. # Procedure: TextBoxFile
  482. # Description: show text box containing a file
  483. # Arguments: {textBoxFile} - filename to read
  484. #            {textBoxCommand} - the command to call after ok
  485. #            {textBoxGeometry} - the geometry for the window
  486. #            {textBoxTitle} - the title for the window
  487. #            {args} - labels of buttons
  488. # Returns: The number of the selected button, ot nothing
  489. # Sideeffects: none
  490. # Notes: there exist also functions called:
  491. #          TextBox - to display a passed string
  492. #          TextBoxFd - to read from an already opened filedescriptor
  493. ##########
  494. #
  495. # global textBox(activeBackground) - active background color
  496. # global textBox(activeForeground) - active foreground color
  497. # global textBox(background) - background color
  498. # global textBox(font) - text font
  499. # global textBox(foreground) - foreground color
  500. # global textBox(scrollActiveForeground) - scrollbar active background color
  501. # global textBox(scrollBackground) - scrollbar background color
  502. # global textBox(scrollForeground) - scrollbar foreground color
  503. # global textBox(scrollSide) - side where scrollbar is located
  504.  
  505.   global textBox
  506.  
  507.   # check file existance
  508.   if {"$textBoxFile" == ""} {
  509.     puts stderr "No filename specified"
  510.     return
  511.   }
  512.  
  513.   if {[catch "open $textBoxFile r" textBoxInFile]} {
  514.     puts stderr "$textBoxInFile"
  515.     return
  516.   }
  517.  
  518.   set textBoxMessage [read $textBoxInFile]
  519.   close $textBoxInFile
  520.  
  521.   # show text box
  522.   if {[llength $args] > 0} {
  523.     eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  524.   } {
  525.     TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  526.   }
  527.  
  528.   if {[llength $args] > 0} {
  529.     # wait for the box to be destroyed
  530.     update idletask
  531.     grab $textBox(toplevelName)
  532.     tkwait window $textBox(toplevelName)
  533.  
  534.     return $textBox(button)
  535.   }
  536. }
  537.  
  538.  
  539. # Procedure: TextBoxInternal
  540. proc TextBoxInternal { textBoxMessage textBoxCommand textBoxGeometry textBoxTitle args} {
  541. # xf ignore me 6
  542.   global textBox
  543.  
  544.   set tmpButtonOpt ""
  545.   set tmpFrameOpt ""
  546.   set tmpMessageOpt ""
  547.   set tmpScrollOpt ""
  548.   if {"$textBox(activeBackground)" != ""} {
  549.     append tmpButtonOpt "-activebackground \"$textBox(activeBackground)\" "
  550.   }
  551.   if {"$textBox(activeForeground)" != ""} {
  552.     append tmpButtonOpt "-activeforeground \"$textBox(activeForeground)\" "
  553.   }
  554.   if {"$textBox(background)" != ""} {
  555.     append tmpButtonOpt "-background \"$textBox(background)\" "
  556.     append tmpFrameOpt "-background \"$textBox(background)\" "
  557.     append tmpMessageOpt "-background \"$textBox(background)\" "
  558.   }
  559.   if {"$textBox(font)" != ""} {
  560.     append tmpButtonOpt "-font \"$textBox(font)\" "
  561.     append tmpMessageOpt "-font \"$textBox(font)\" "
  562.   }
  563.   if {"$textBox(foreground)" != ""} {
  564.     append tmpButtonOpt "-foreground \"$textBox(foreground)\" "
  565.     append tmpMessageOpt "-foreground \"$textBox(foreground)\" "
  566.   }
  567.   if {"$textBox(scrollActiveForeground)" != ""} {
  568.     append tmpScrollOpt "-activeforeground \"$textBox(scrollActiveForeground)\" "
  569.   }
  570.   if {"$textBox(scrollBackground)" != ""} {
  571.     append tmpScrollOpt "-background \"$textBox(scrollBackground)\" "
  572.   }
  573.   if {"$textBox(scrollForeground)" != ""} {
  574.     append tmpScrollOpt "-foreground \"$textBox(scrollForeground)\" "
  575.   }
  576.  
  577.   # start build of toplevel
  578.   if {"[info commands XFDestroy]" != ""} {
  579.     catch {XFDestroy $textBox(toplevelName)}
  580.   } {
  581.     catch {destroy $textBox(toplevelName)}
  582.   }
  583.   toplevel $textBox(toplevelName)  -borderwidth 0
  584.   catch "$textBox(toplevelName) config $tmpFrameOpt"
  585.   if {[catch "wm geometry $textBox(toplevelName) $textBoxGeometry"]} {
  586.     wm geometry $textBox(toplevelName) 350x150
  587.   }
  588.   wm title $textBox(toplevelName) $textBoxTitle
  589.   wm maxsize $textBox(toplevelName) 1000 1000
  590.   wm minsize $textBox(toplevelName) 100 100
  591.   # end build of toplevel
  592.  
  593.   frame $textBox(toplevelName).frame0  -borderwidth 0  -relief raised
  594.   catch "$textBox(toplevelName).frame0 config $tmpFrameOpt"
  595.  
  596.   text $textBox(toplevelName).frame0.text1  -relief raised  -wrap none  -borderwidth 2  -yscrollcommand "$textBox(toplevelName).frame0.vscroll set"
  597.   catch "$textBox(toplevelName).frame0.text1 config $tmpMessageOpt"
  598.  
  599.   scrollbar $textBox(toplevelName).frame0.vscroll  -relief raised  -command "$textBox(toplevelName).frame0.text1 yview"
  600.   catch "$textBox(toplevelName).frame0.vscroll config $tmpScrollOpt"
  601.  
  602.   frame $textBox(toplevelName).frame1  -borderwidth 0  -relief raised
  603.   catch "$textBox(toplevelName).frame1 config $tmpFrameOpt"
  604.  
  605.   set textBoxCounter 0
  606.   set buttonNum [llength $args]
  607.  
  608.   if {$buttonNum > 0} {
  609.     while {$textBoxCounter < $buttonNum} {
  610.       button $textBox(toplevelName).frame1.button$textBoxCounter  -text "[lindex $args $textBoxCounter]"  -command "
  611.           global textBox
  612.           set textBox(button) $textBoxCounter
  613.           set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\]
  614.           if {\"\[info commands XFDestroy\]\" != \"\"} {
  615.             catch {XFDestroy $textBox(toplevelName)}
  616.           } {
  617.             catch {destroy $textBox(toplevelName)}
  618.           }"
  619.       catch "$textBox(toplevelName).frame1.button$textBoxCounter config $tmpButtonOpt"
  620.  
  621.       pack append $textBox(toplevelName).frame1  $textBox(toplevelName).frame1.button$textBoxCounter {left fillx expand}
  622.  
  623.       incr textBoxCounter
  624.     }
  625.   } {
  626.     button $textBox(toplevelName).frame1.button0  -text "OK"  -command "
  627.         global textBox
  628.         set textBox(button) 0
  629.         set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\]
  630.         if {\"\[info commands XFDestroy\]\" != \"\"} {
  631.           catch {XFDestroy $textBox(toplevelName)}
  632.         } {
  633.           catch {destroy $textBox(toplevelName)}
  634.         }
  635.         $textBoxCommand"
  636.     catch "$textBox(toplevelName).frame1.button0 config $tmpButtonOpt"
  637.  
  638.     pack append $textBox(toplevelName).frame1  $textBox(toplevelName).frame1.button0 {left fillx expand}
  639.   }
  640.  
  641.   $textBox(toplevelName).frame0.text1 insert end "$textBoxMessage"
  642.  
  643.   $textBox(toplevelName).frame0.text1 config  -state $textBox(state)
  644.  
  645.   # packing
  646.   pack append $textBox(toplevelName).frame0  $textBox(toplevelName).frame0.vscroll "$textBox(scrollSide) filly"  $textBox(toplevelName).frame0.text1 {left fill expand}
  647.   pack append $textBox(toplevelName)  $textBox(toplevelName).frame1 {bottom fill}  $textBox(toplevelName).frame0 {top fill expand}
  648. }
  649.  
  650.  
  651. # Internal procedures
  652.  
  653.  
  654. # Procedure: Alias
  655. proc Alias { args} {
  656. # xf ignore me 7
  657. ##########
  658. # Procedure: Alias
  659. # Description: establish an alias for a procedure
  660. # Arguments: args - no argument means that a list of all aliases
  661. #                   is returned. Otherwise the first parameter is
  662. #                   the alias name, and the second parameter is
  663. #                   the procedure that is aliased.
  664. # Returns: nothing, the command that is bound to the alias or a
  665. #          list of all aliases - command pairs. 
  666. # Sideeffects: internalAliasList is updated, and the alias
  667. #              proc is inserted
  668. ##########
  669.   global internalAliasList
  670.  
  671.   if {[llength $args] == 0} {
  672.     return $internalAliasList
  673.   } {
  674.     if {[llength $args] == 1} {
  675.       set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
  676.       if {$xfTmpIndex != -1} {
  677.         return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
  678.       }
  679.     } {
  680.       if {[llength $args] == 2} {
  681.         eval "proc [lindex $args 0] {args} {#xf ignore me 4
  682. return \[eval \"[lindex $args 1] \$args\"\]}"
  683.         set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
  684.         if {$xfTmpIndex != -1} {
  685.           set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
  686.         } {
  687.           lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
  688.         }
  689.       } {
  690.         error "Alias: wrong number or args: $args"
  691.       }
  692.     }
  693.   }
  694. }
  695.  
  696.  
  697. # Procedure: GetSelection
  698. if {"[info procs GetSelection]" == ""} {
  699. proc GetSelection {} {
  700. # xf ignore me 7
  701. ##########
  702. # Procedure: GetSelection
  703. # Description: get current selection
  704. # Arguments: none
  705. # Returns: none
  706. # Sideeffects: none
  707. ##########
  708.  
  709.   # the save way
  710.   set xfSelection ""
  711.   catch "selection get" xfSelection
  712.   if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
  713.     return ""
  714.   } {
  715.     return $xfSelection
  716.   }
  717. }
  718. }
  719.  
  720.  
  721. # Procedure: MenuPopupAdd
  722. if {"[info procs MenuPopupAdd]" == ""} {
  723. proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} {
  724. # xf ignore me 7
  725. # the popup menu handling is from (I already gave up with popup handling :-):
  726. #
  727. # Copyright 1991,1992 by James Noble.
  728. # Everyone is granted permission to copy, modify and redistribute.
  729. # This notice must be preserved on all copies or derivates.
  730. #
  731. ##########
  732. # Procedure: MenuPopupAdd
  733. # Description: attach a popup menu to widget
  734. # Arguments: xfW - the widget
  735. #            xfButton - the button we use
  736. #            xfMenu - the menu to attach
  737. #            {xfModifier} - a optional modifier
  738. #            {xfCanvasTag} - a canvas tagOrId
  739. # Returns: none
  740. # Sideeffects: none
  741. ##########
  742.  
  743.   if {"$xfModifier" != ""} {
  744.     set xfPressModifier "$xfModifier-"
  745.     set xfMoveModifier "$xfModifier-"
  746.     set xfReleaseModifier "Any-"
  747.   } {
  748.     set xfPressModifier ""
  749.     set xfMoveModifier ""
  750.     set xfReleaseModifier ""
  751.   }
  752.  
  753.   if {"$xfCanvasTag" == ""} {
  754.     if {[catch "bind $xfW \"<${xfPressModifier}ButtonPress-$xfButton>\"  \"$xfMenu post %X %Y\"" xfResult]} {
  755.       if {"[info commands XFProcError]" != ""} {
  756.         XFProcError "$xfResult"
  757.       } {
  758.         puts stdout "$xfResult"
  759.       }
  760.       return
  761.     }
  762.     if {[catch "bind $xfW \"<${xfMoveModifier}B$xfButton-Motion>\"  \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} {
  763.       if {"[info commands XFProcError]" != ""} {
  764.         XFProcError "$xfResult"
  765.       } {
  766.         puts stdout "$xfResult"
  767.       }
  768.       return
  769.     }
  770.     # we need these to counteract the effects of passive grabs :-(
  771.     if {[catch "bind $xfW \"<${xfReleaseModifier}ButtonRelease-$xfButton>\"  \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} {
  772.       if {"[info commands XFProcError]" != ""} {
  773.         XFProcError "$xfResult"
  774.       } {
  775.         puts stdout "$xfResult"
  776.       }
  777.       return
  778.     }
  779.   } {
  780.     if {[catch "$xfW bind $xfCanvasTag \"<${xfPressModifier}ButtonPress-$xfButton>\"  \"$xfMenu post %X %Y\"" xfResult]} {
  781.       if {"[info commands XFProcError]" != ""} {
  782.         XFProcError "$xfResult"
  783.       } {
  784.         puts stdout "$xfResult"
  785.       }
  786.       return
  787.     }
  788.     if {[catch "$xfW bind $xfCanvasTag \"<${xfMoveModifier}B$xfButton-Motion>\"  \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} {
  789.       if {"[info commands XFProcError]" != ""} {
  790.         XFProcError "$xfResult"
  791.       } {
  792.         puts stdout "$xfResult"
  793.       }
  794.       return
  795.     }
  796.     # we need these to counteract the effects of passive grabs :-(
  797.     if {[catch "$xfW bind $xfCanvasTag \"<${xfReleaseModifier}ButtonRelease-$xfButton>\"  \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} {
  798.       if {"[info commands XFProcError]" != ""} {
  799.         XFProcError "$xfResult"
  800.       } {
  801.         puts stdout "$xfResult"
  802.       }
  803.       return
  804.     }
  805.   }
  806. }
  807. }
  808.  
  809.  
  810. # Procedure: MenuPopupHandle
  811. if {"[info procs MenuPopupHandle]" == ""} {
  812. proc MenuPopupHandle { xfMenu xfW xfX xfY} {
  813. # xf ignore me 7
  814. ##########
  815. # Procedure: MenuPopupHandle
  816. # Description: handle the popup menus
  817. # Arguments: xfMenu - the menu to attach
  818. #            xfW - the widget
  819. #            xfX - the root x coordinate
  820. #            xfY - the root x coordinate
  821. # Returns: none
  822. # Sideeffects: none
  823. ##########
  824.  
  825.   if {"[info commands $xfMenu]" != "" && [winfo ismapped $xfMenu]} {
  826.     set xfPopMinX [winfo rootx $xfMenu]
  827.     set xfPopMaxX [expr $xfPopMinX+[winfo width $xfMenu]]
  828.     if {($xfX >= $xfPopMinX) &&  ($xfX <= $xfPopMaxX)} {
  829.       $xfMenu activate @[expr $xfY-[winfo rooty $xfMenu]]
  830.     } {
  831.       $xfMenu activate none
  832.     }
  833.   }
  834. }
  835. }
  836.  
  837.  
  838. # Procedure: NoFunction
  839. if {"[info procs NoFunction]" == ""} {
  840. proc NoFunction { args} {
  841. # xf ignore me 7
  842. ##########
  843. # Procedure: NoFunction
  844. # Description: do nothing (especially with scales and scrollbars)
  845. # Arguments: args - a number of ignored parameters
  846. # Returns: none
  847. # Sideeffects: none
  848. ##########
  849. }
  850. }
  851.  
  852.  
  853. # Procedure: SN
  854. if {"[info procs SN]" == ""} {
  855. proc SN { {xfName ""}} {
  856. # xf ignore me 7
  857. ##########
  858. # Procedure: SN
  859. # Description: map a symbolic name to the widget path
  860. # Arguments: xfName
  861. # Returns: the symbolic name
  862. # Sideeffects: none
  863. ##########
  864.  
  865.   SymbolicName $xfName
  866. }
  867. }
  868.  
  869.  
  870. # Procedure: SymbolicName
  871. if {"[info procs SymbolicName]" == ""} {
  872. proc SymbolicName { {xfName ""}} {
  873. # xf ignore me 7
  874. ##########
  875. # Procedure: SymbolicName
  876. # Description: map a symbolic name to the widget path
  877. # Arguments: xfName
  878. # Returns: the symbolic name
  879. # Sideeffects: none
  880. ##########
  881.  
  882.   global symbolicName
  883.  
  884.   if {"$xfName" != ""} {
  885.     set xfArrayName ""
  886.     append xfArrayName symbolicName ( $xfName )
  887.     if {![catch "set \"$xfArrayName\"" xfValue]} {
  888.       return $xfValue
  889.     } {
  890.       if {"[info commands XFProcError]" != ""} {
  891.         XFProcError "Unknown symbolic name:\n$xfName"
  892.       } {
  893.         puts stderr "XF error: unknown symbolic name:\n$xfName"
  894.       }
  895.     }
  896.   }
  897.   return ""
  898. }
  899. }
  900.  
  901.  
  902. # Procedure: Unalias
  903. proc Unalias { aliasName} {
  904. # xf ignore me 7
  905. ##########
  906. # Procedure: Unalias
  907. # Description: remove an alias for a procedure
  908. # Arguments: aliasName - the alias name to remove
  909. # Returns: none
  910. # Sideeffects: internalAliasList is updated, and the alias
  911. #              proc is removed
  912. ##########
  913.   global internalAliasList
  914.  
  915.   set xfIndex [lsearch $internalAliasList "$aliasName *"]
  916.   if {$xfIndex != -1} {
  917.     rename $aliasName ""
  918.     set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
  919.   }
  920. }
  921.  
  922.  
  923.  
  924. # application parsing procedure
  925. proc XFLocalParseAppDefs {xfAppDefFile} {
  926.   global xfAppDefaults
  927.  
  928.   # basically from: Michael Moore
  929.   if {[file exists $xfAppDefFile] &&
  930.       [file readable $xfAppDefFile] &&
  931.       "[file type $xfAppDefFile]" == "link"} {
  932.     catch "file type $xfAppDefFile" xfType
  933.     while {"$xfType" == "link"} {
  934.       if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} {
  935.         return
  936.       }
  937.       catch "file type $xfAppDefFile" xfType
  938.     }
  939.   }
  940.   if {!("$xfAppDefFile" != "" &&
  941.         [file exists $xfAppDefFile] &&
  942.         [file readable $xfAppDefFile] &&
  943.         "[file type $xfAppDefFile]" == "file")} {
  944.     return
  945.   }
  946.   if {![catch "open $xfAppDefFile r" xfResult]} {
  947.     set xfAppFileContents [read $xfResult]
  948.     close $xfResult
  949.     foreach line [split $xfAppFileContents "\n"] {
  950.       # backup indicates how far to backup.  It applies to the
  951.       # situation where a resource name ends in . and when it
  952.       # ends in *.  In the second case you want to keep the *
  953.       # in the widget name for pattern matching, but you want
  954.       # to get rid of the . if it is the end of the name. 
  955.       set backup -2  
  956.       set line [string trim $line]
  957.       if {[string index $line 0] == "#" || "$line" == ""} {
  958.         # skip comments and empty lines
  959.         continue
  960.       }
  961.       set list [split $line ":"]
  962.       set resource [string trim [lindex $list 0]]
  963.       set i [string last "." $resource]
  964.       set j [string last "*" $resource]
  965.       if {$j > $i} { 
  966.         set i $j
  967.         set backup -1
  968.       }
  969.       incr i
  970.       set name [string range $resource $i end]
  971.       incr i $backup
  972.       set widname [string range $resource 0 $i]
  973.       set value [string trim [lindex $list 1]]
  974.       if {"$widname" != "" && "$widname" != "*"} {
  975.         # insert the widget and resourcename to the application
  976.         # defaults list.
  977.         set xfAppDefaults($widname:[string tolower $name]) $value
  978.       }
  979.     }
  980.   }
  981. }
  982.  
  983. # application loading procedure
  984. proc XFLocalLoadAppDefs {xfClasses {xfPriority "startupFile"} {xfAppDefFile ""}} {
  985.   global env
  986.  
  987.   if {"$xfAppDefFile" == ""} {
  988.     set xfFileList ""
  989.     if {[info exists env(XUSERFILESEARCHPATH)]} {
  990.       append xfFileList [split $env(XUSERFILESEARCHPATH) :]
  991.     }
  992.     if {[info exists env(XAPPLRESDIR)]} {
  993.       append xfFileList [split $env(XAPPLRESDIR) :]
  994.     }
  995.     if {[info exists env(XFILESEARCHPATH)]} {
  996.       append xfFileList [split $env(XFILESEARCHPATH) :]
  997.     }
  998.     append xfFileList " /usr/lib/X11/app-defaults"
  999.     append xfFileList " /usr/X11/lib/X11/app-defaults"
  1000.  
  1001.     foreach xfCounter1 $xfClasses {
  1002.       foreach xfCounter2 $xfFileList {
  1003.         set xfPathName $xfCounter2
  1004.         if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} {
  1005.           set xfPathName $xfResult
  1006.         }
  1007.         if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} {
  1008.           set xfPathName $xfResult
  1009.         }
  1010.         if {[regsub -all "%S" "$xfPathName" "" xfResult]} {
  1011.           set xfPathName $xfResult
  1012.         }
  1013.         if {[regsub -all "%C" "$xfPathName" "" xfResult]} {
  1014.           set xfPathName $xfResult
  1015.         }
  1016.         if {[file exists $xfPathName] &&
  1017.             [file readable $xfPathName] &&
  1018.             ("[file type $xfPathName]" == "file" ||
  1019.              "[file type $xfPathName]" == "link")} {
  1020.           catch "option readfile $xfPathName $xfPriority"
  1021.           if {"[info commands XFParseAppDefs]" != ""} {
  1022.             XFParseAppDefs $xfPathName
  1023.           } {
  1024.             if {"[info commands XFLocalParseAppDefs]" != ""} {
  1025.               XFLocalParseAppDefs $xfPathName
  1026.             }
  1027.           }
  1028.         } {
  1029.           if {[file exists $xfCounter2/$xfCounter1] &&
  1030.               [file readable $xfCounter2/$xfCounter1] &&
  1031.               ("[file type $xfCounter2/$xfCounter1]" == "file" ||
  1032.                "[file type $xfCounter2/$xfCounter1]" == "link")} {
  1033.             catch "option readfile $xfCounter2/$xfCounter1 $xfPriority"
  1034.             if {"[info commands XFParseAppDefs]" != ""} {
  1035.               XFParseAppDefs $xfCounter2/$xfCounter1
  1036.             } {
  1037.               if {"[info commands XFLocalParseAppDefs]" != ""} {
  1038.                 XFLocalParseAppDefs $xfCounter2/$xfCounter1
  1039.               }
  1040.             }
  1041.           }
  1042.         }
  1043.       }
  1044.     }
  1045.   } {
  1046.     # load a specific application defaults file
  1047.     if {[file exists $xfAppDefFile] &&
  1048.         [file readable $xfAppDefFile] &&
  1049.         ("[file type $xfAppDefFile]" == "file" ||
  1050.          "[file type $xfAppDefFile]" == "link")} {
  1051.       catch "option readfile $xfAppDefFile $xfPriority"
  1052.       if {"[info commands XFParseAppDefs]" != ""} {
  1053.         XFParseAppDefs $xfAppDefFile
  1054.       } {
  1055.         if {"[info commands XFLocalParseAppDefs]" != ""} {
  1056.           XFLocalParseAppDefs $xfAppDefFile
  1057.         }
  1058.       }
  1059.     }
  1060.   }
  1061. }
  1062.  
  1063. # application setting procedure
  1064. proc XFLocalSetAppDefs {{xfWidgetPath "."}} {
  1065.   global xfAppDefaults
  1066.  
  1067.   if {![info exists xfAppDefaults]} {
  1068.     return
  1069.   }
  1070.   foreach xfCounter [array names xfAppDefaults] {
  1071.     if {[string match "${xfWidgetPath}*" $xfCounter]} {
  1072.       set widname [string range $xfCounter 0 [expr [string first : $xfCounter]-1]]
  1073.       set name [string range $xfCounter [expr [string first : $xfCounter]+1] end]
  1074.       # Now lets see how many tcl commands match the name
  1075.       # pattern specified.
  1076.       set widlist [info command $widname]
  1077.       if {"$widlist" != ""} {
  1078.         foreach widget $widlist {
  1079.           # make sure this command is a widget.
  1080.           if {![catch "winfo id $widget"]} {
  1081.             catch "$widget configure -[string tolower $name] $xfAppDefaults($xfCounter)" 
  1082.           }
  1083.         }
  1084.       }
  1085.     }
  1086.   }
  1087. }
  1088.  
  1089.  
  1090. # prepare auto loading
  1091. global auto_path
  1092. global tk_library
  1093. global xfLoadPath
  1094. set auto_path "[split $xfLoadPath :] $tk_library [info library]"
  1095.  
  1096. # initialize global variables
  1097. proc InitGlobals {} {
  1098.   global {textBox}
  1099.   set {textBox(activeBackground)} {}
  1100.   set {textBox(activeForeground)} {}
  1101.   set {textBox(background)} {}
  1102.   set {textBox(button)} {0}
  1103.   set {textBox(contents)} {Role Playing DataBase System Installation Help
  1104.  
  1105. The Role Playing DataBase System needs four paths:
  1106.  
  1107.   1) The name of te directory the scripts are to be installed
  1108.      in.
  1109.   2) The installed filename for the customized RPG wish.
  1110.   3) The name of the /bin/sh script to start up the 
  1111.      Role Playing DataBase System.
  1112.   4) The directory where the Info file (on-line help).
  1113.  
  1114. Enter the four paths and then select the Install It! button.
  1115. If the installation was successfull, the Install program will
  1116. go away.  Otherwise an error message will popup.
  1117. }
  1118.   set {textBox(font)} {}
  1119.   set {textBox(foreground)} {}
  1120.   set {textBox(scrollActiveForeground)} {}
  1121.   set {textBox(scrollBackground)} {}
  1122.   set {textBox(scrollForeground)} {}
  1123.   set {textBox(scrollSide)} {left}
  1124.   set {textBox(state)} {disabled}
  1125.   set {textBox(toplevelName)} {.textBox}
  1126.  
  1127.   # please don't modify the following
  1128.   # variables. They are needed by xf.
  1129.   global {autoLoadList}
  1130.   set {autoLoadList(Install.tcl)} {0}
  1131.   set {autoLoadList(main.tcl)} {0}
  1132.   global {internalAliasList}
  1133.   set {internalAliasList} {}
  1134.   global {moduleList}
  1135.   set {moduleList(Install.tcl)} {}
  1136.   global {preloadList}
  1137.   set {preloadList(xfInternal)} {}
  1138.   global {symbolicName}
  1139.   set {symbolicName(BinPath)} {.frame3.entry13}
  1140.   set {symbolicName(ExecutablePath)} {.frame2.entry19}
  1141.   set {symbolicName(InfoPath)} {.frame4.entry15}
  1142.   set {symbolicName(InstallButton)} {.frame5.button16}
  1143.   set {symbolicName(ScriptPath)} {.frame1.entry7}
  1144.   set {symbolicName(root)} {.}
  1145.   global {xfWmSetPosition}
  1146.   set {xfWmSetPosition} {}
  1147.   global {xfWmSetSize}
  1148.   set {xfWmSetSize} {}
  1149.   global {xfAppDefToplevels}
  1150.   set {xfAppDefToplevels} {}
  1151. }
  1152.  
  1153. # initialize global variables
  1154. InitGlobals
  1155.  
  1156. # display/remove toplevel windows.
  1157. ShowWindow.
  1158.  
  1159. # load default bindings.
  1160. if {[info exists env(XF_BIND_FILE)] &&
  1161.     "[info procs XFShowHelp]" == ""} {
  1162.   source $env(XF_BIND_FILE)
  1163. }
  1164.  
  1165. # parse and apply application defaults.
  1166. XFLocalLoadAppDefs Install
  1167. XFLocalSetAppDefs
  1168.  
  1169. # eof
  1170. #
  1171.  
  1172.